home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Franz PD / Franz PD Disk #240 (1993)(Rhein-Sieg-Soft).zip / Franz PD Disk #240 (1993)(Rhein-Sieg-Soft).adf / ELIZA.LST < prev    next >
File List  |  1993-06-02  |  57KB  |  1,724 lines
  1. ' **********************************
  2. ' *     Eliza 1.20p    26.9.1991   *
  3. ' *   (c) H. König, 2 Hamburg 53   *
  4. ' **********************************
  5. RESERVE 170000
  6. init                            ! Initialisieren
  7. init.sprache
  8. init.deutsch
  9. menueein                        ! Menüs einschalten
  10. info                            ! Startinfo
  11. start:
  12. programmkopf
  13. anweisung(27)
  14. ON MENU GOSUB menÜkontrolle
  15. REPEAT
  16.   SLEEP
  17. UNTIL ende!
  18. CLOSEW #1
  19. CLOSES 1
  20. END                             ! system
  21. PROCEDURE abfrage.ja
  22.   y$="J"
  23.   abfragen
  24. RETURN
  25. PROCEDURE abfrage.nein
  26.   y$="N"
  27.   abfragen
  28. RETURN
  29. PROCEDURE abfragen
  30.   anweisung(aw%)
  31.   anweisung(18)
  32.   CLR x%
  33.   mausk%=0
  34.   ay%=ay%(aw%)+5+LEN(aw$(aw%))
  35.   ay%=ay%*8-16                  ! Rechtswert
  36.   ax%=ax%(aw%)*8-12             ! Hochwert
  37.   COLOR 2                       ! schwarz
  38.   BOX ay%,ax%,ay%+64,ax%+14
  39.   COLOR 4                       ! hellgrau
  40.   LINE ay%+1,ax%+1,ay%+63,ax%+1
  41.   LINE ay%,ax%+1,ay%,ax%+14
  42.   WHILE mausk%<>2 AND x%<>13
  43.     IF y$="J" THEN
  44.       COLOR 2
  45.       LOCATE ay%(aw%)+5+LEN(aw$(aw%)),ax%(aw%)
  46.       textstil(7,3,6)           ! Invers
  47.       PRINT " J ";
  48.       textstil(0,1,0)           ! Invers aus
  49.       PRINT " N ";
  50.       y$="J"
  51.     ELSE
  52.       LOCATE ay%(aw%)+5+LEN(aw$(aw%)),ax%(aw%)
  53.       textstil(0,1,0)           ! Invers aus
  54.       PRINT " J ";
  55.       textstil(7,3,6)           ! Invers
  56.       PRINT " N ";
  57.       y$="N"
  58.     ENDIF
  59.     taste
  60.     IF UPPER$(x$)="J" THEN
  61.       y$="J"
  62.     ELSE IF UPPER$(x$)="N"
  63.       y$="N"
  64.     ENDIF
  65.     IF mausy%=ax%(aw%) THEN     ! Abfragefeld (Zeile) angeklickt?
  66.       IF mausx%-1>ay%(aw%)+3+LEN(aw$(aw%)) AND mausx%-1<ay%(aw%)+8+LEN(aw$(aw%)) THEN
  67.         y$="J"
  68.       ELSE IF mausx%-1>ay%(aw%)+7+LEN(aw$(aw%)) AND mausx%-1<ay%(aw%)+11+LEN(aw$(aw%))
  69.         y$="N"
  70.       ENDIF
  71.     ELSE
  72.       x1%=ASC(MID$(x$,2,1))-37
  73.       IF x1%=30 THEN            ! Cursor rechts?
  74.         y$="N"                  ! ja, dann nein gewahlt
  75.       ELSE IF x1%=31            ! Cursor links?
  76.         y$="J"                  ! ja, dann ja gewahlt
  77.       ENDIF
  78.     ENDIF
  79.   WEND
  80.   textstil(0,1,0)               ! Invers aus
  81.   programmfuss
  82. RETURN
  83. PROCEDURE anpassen1             ! Sonderzeichen der Sprachausgabe anpassen
  84.   x1$="ä"                       ! kleines ä
  85.   x2$="["                       ! Ersatzwert
  86.   anpassen
  87.   x1$="Ä"                       ! großes Ä
  88.   x2$="["                       ! Ersatzwert
  89.   anpassen
  90.   x1$="ö"                       ! kleines ö
  91.   x2$="\"                       ! Ersatzwert
  92.   anpassen
  93.   x1$="Ö"                       ! großes Ö
  94.   x2$="\"                       ! Ersatzwert
  95.   anpassen
  96.   x1$="ü"                       ! kleines ü
  97.   x2$="]"                       ! Ersatzwert
  98.   anpassen
  99.   x1$="Ü"                       ! großes Ü
  100.   x2$="]"                       ! Ersatzwert
  101.   anpassen
  102.   x1$="ß"
  103.   x2$="^"                       ! Ersatzwert
  104.   anpassen
  105.   x1$=" "                       ! Space
  106.   x2$="@"                       ! Ersatzwert
  107.   anpassen
  108. RETURN
  109. PROCEDURE anpassen              ! Umlaute und ß anpassen
  110.   j1%=-1                        ! Schleifeneingangswert
  111.   WHILE j1%<>0
  112.     j1%=j1%+1                   ! Position im String
  113.     j1%=INSTR(j1%+1,t$,x1$)     ! Zeichen suchen
  114.     IF j1%>0 THEN               ! Zeichen gefunden?
  115.       MID$(t$,j1%,1)=x2$        ! ja, dann Zeichen austauschen
  116.     ENDIF
  117.   WEND
  118. RETURN
  119. PROCEDURE antwort.suchen        ! noch nicht benutzten Text suchen
  120.   CLR ok%                       ! Flag löschen
  121.   beugen                        ! Worte beugen
  122.   IF ig%>0 AND frage%=1 THEN    ! Text zur Beantwortung der Frage vorhanden
  123.     j1%=1+RAND(ig%)
  124.     i%=in%(j1%,1)               ! ja, dann Recordnummer übergeben
  125.     satz.lesen                  ! Datensatz lesen
  126.     komp%=VAL(te$(3))           ! Kompositionsflag merken
  127.     ok%=1                       ! Flag Datensatz gefunden
  128.   ELSE IF ig%>0 AND frage%=0    ! Text gefunden, war aber keine Frage
  129.     j1%=1+RAND(ig%)
  130.     i%=in%(j1%,1)               ! ja, dann Recordnummer übergeben
  131.     satz.lesen                  ! Datensatz lesen
  132.     komp%=VAL(te$(3))           ! Kompositionsflag merken
  133.     ok%=1                       ! Flag Datensatz gefunden
  134.   ENDIF
  135.   IF ok%=1 THEN                 ! Satz in der Datei gefunden
  136.     t$=""                       ! Rückgabestring löschen
  137.     IF komp%=0 THEN             ! Antwort auf eine Frage nach gefundenem Schl.
  138.       t$=TRIM$(te$(2))          ! Antwort auf die Frage
  139.     ELSE IF komp%=1             ! Eingabe beugen und Satz anhängen
  140.       FOR j1%=1 TO w%
  141.         t$=t$+e1$(j1%)+" "      ! umgebaute Eingabe zusammensetzen
  142.       NEXT j1%
  143.       t$=TRIM$(t$)+TRIM$(te$(2))! Antwort anhängen
  144.     ELSE IF komp%=2             ! Verlegenheitsfrage stellen
  145.       t$=TRIM$(te$(2))          ! Verlegenheitsfrage übergeben
  146.     ELSE IF komp%=3             ! Gegenfrage ohne die Antwort zu wiederholen
  147.       t$=TRIM$(te$(2))
  148.     ENDIF
  149.     z%(i%)=1                    ! Schlüsselwort als benutzt kennzeichnen
  150.   ENDIF
  151. RETURN
  152. PROCEDURE anweisung(aw%)
  153.   PRINT AT(4,ax%(aw%));SPACE$(74) ! Zeile löschen
  154.   PRINT AT(ay%(aw%),ax%(aw%));aw$(aw%) ! Anweisung ausgeben
  155. RETURN
  156. PROCEDURE bearbeitungszeit
  157.   programmkopf
  158.   PRINT AT(4,28);"Importdauer: Festplatte ca. ";
  159.   PRINT n% DIV 70;" Sekunden, Diskette ca. ";
  160.   PRINT n% DIV 40;" Sekunden."
  161. RETURN
  162. PROCEDURE beenden               ! Programm beenden
  163.   ALERT 0,"Wollen Sie aufhören",1,"Ende|Weiter",wahl%
  164.   ende!=(wahl%=1)
  165. RETURN
  166. PROCEDURE beugen                ! Worte der Eingabe beugen
  167.   CLR x%
  168.   CLR x1%
  169.   FOR j%=1 TO w%
  170.     IF UPPER$(e1$(j%))="UND" OR UPPER$(e1$(j%))="ODER" THEN
  171.       INC x%
  172.     ELSE IF UPPER$(e1$(1))="DU"
  173.       x1%=1
  174.     ELSE IF UPPER$(e1$(1))="IHR"
  175.       x1%=2
  176.     ENDIF
  177.   NEXT j%
  178.   IF x1%>0 AND NOT x% THEN
  179.     RESTORE beugungen
  180.     x$=""                       ! Eingangswert für die Schleife
  181.     CLR x%
  182.     WHILE x$<>"ende" AND x%=0
  183.       READ x$,y$
  184.       IF UPPER$(e1$(2))=UPPER$(x$) THEN
  185.         e1$(2)=y$               ! Beugung übernehmen
  186.         x%=1                    ! Schleife abbrechen
  187.       ENDIF
  188.     WEND
  189.     IF x$="ende" THEN           ! keine Beugung gefunden
  190.       e1$(2)=e1$(2)+"st"        ! 'st' anhängen
  191.     ENDIF
  192.   ENDIF
  193. RETURN
  194. PROCEDURE blaettern
  195.   IF tx%>1 THEN                 ! mindestens 2 Datensatze vorhanden?
  196.     IF i%<1 THEN                ! Datensatzposition kleiner 1
  197.       i%=tx%                    ! ja, Datensatzposition = letzter Datensatz
  198.     ELSE IF i%>tx%              ! Position grosser letzten datensatz?
  199.       i%=1                      ! Datensatzposition = 1. Datensatz
  200.     ENDIF
  201.     satz.lesen
  202.     daten.zeigen
  203.   ENDIF
  204. RETURN
  205. PROCEDURE check.datei           ! Datei schon ausgewählt?
  206.   CLR abbruch%                  ! Flag löschen
  207.   IF dimflag%=0 THEN            ! Datei schon ausgewählt
  208.     index.ein                   ! nein, dann Datei auswählen
  209.   ENDIF
  210.   IF dimflag%=0 AND abbruch%=1 THEN ! Auswahl abgebrochen
  211.     RESUME start                ! neu starten
  212.   ENDIF
  213. RETURN
  214. PROCEDURE cursor.aus
  215.   LOCATE spalte%+sp%,zeile%        ! Cursor positionieren
  216.   textstil(0,1,0)               ! Invers ausschalten
  217.   PRINT MID$(t$,sp%,1)           ! Zeichen ausgeben
  218. RETURN
  219. PROCEDURE daten.aendern         ! Datensatz in der Maske ändern
  220.   daten.zeigen                  ! Datensatz anzeigen
  221.   anweisung(14)
  222.   daten.eingeben1               ! Datensatz über Maske eingeben/ändern
  223.   satz.schreiben                ! Datensatz schreiben
  224.   CLR x%
  225.   um%=2
  226. RETURN
  227. PROCEDURE daten.bereitst        ! Daten der Hauptdatei einlesen
  228.   check.datei                   ! Datei schon ausgewählt
  229.   CLR tx%
  230.   y$="J"
  231.   bearbeitungszeit
  232.   anweisung(16)                 ! Unterbrechung
  233.   oeffne.r
  234.   CLR abbruch%                  ! Abbruchflag löschen
  235.   CLR rn%
  236.   WHILE rn%<n% AND abbruch%=0
  237.     INC rn%
  238.     unterbrechung               ! auf Unterbrechung prüfen
  239.     IF tx%>=mg% THEN
  240.       IF pwd%=0 THEN
  241.         passwort
  242.         IF pwd%=0 THEN
  243.           rn%=n%
  244.         ENDIF
  245.       ELSE
  246.         anweisung(28)           ! Speicher ist voll
  247.         tastendruck
  248.         rn%=n%
  249.       ENDIF
  250.     ENDIF
  251.     GET #1,rn%                  ! Datensatz lesen
  252.     vergleich
  253.     IF vflag%=1 THEN            ! in Indexdatei übernehmen
  254.       INC tx%                   ! Indexzähler +1
  255.       rc%(tx%)=rn%              ! Recordnummer merken
  256.       a$(tx%)=MID$(record$,po%(id%(0)),il%)
  257.       PRINT AT(73,2);tx%
  258.     ENDIF
  259.   WEND
  260.   CLOSE
  261.   CLR sortflag%                 ! Flag für unsortierte Datei setzen
  262.   sortieren
  263. RETURN
  264. PROCEDURE daten.eingeben        ! Dateneingabe über Maske
  265.   PRINT AT(4,31);SPACE$(74)     ! Zeile löschen
  266.   PRINT AT(4,31);"Nur mit Shareversion oder 'Datei' möglich"
  267.   tastendruck                   ! auf Tastendruck warten
  268.   anweisung(17)                 ! Anweisung zur Steuerung ausgeben
  269. RETURN
  270. PROCEDURE daten.eingeben1       ! einen Datensatz über Maskeneingabe
  271.   j%=1                          ! Feldzähler =1
  272.   REPEAT                        ! Schleife ausführen
  273.     sp%=1                        ! Spalte =1
  274.     daten.eingeben1.1:
  275.     IF j%>be% THEN              ! Feldzähler > letztes Feld
  276.       j%=1                      ! ja, dann Feldzähler =1
  277.     ELSE IF j%<1                ! Feldzähler < 1
  278.       j%=be%                    ! ja, dann Feldzähler = letztes Feld
  279.     ENDIF
  280.     eingabe(sp%,sz%+mx%(j%),my%(j%),td%(j%),te$(j%)) ! Eingabe holen
  281.     IF mnr%=1 THEN              ! Routine wurde von Datenpflege aufgerufen
  282.       prÜfe.vorgabe.input(j%,tx$) ! Datenfeld nach Input-Flag anpassen
  283.     ENDIF
  284.     SWAP te$(j%),tx$            ! Eingabe an Feld zurückgeben
  285.     daten.zeigen1               ! Datenfeld in der Maske ausgeben
  286.     IF mausy%>=sz% AND mausy%<28 AND mausk%=1 THEN ! Maussteuerung?
  287.       CLR x%                    ! ja, Tastatursteuerung zurücksetzen
  288.       zzaehler%=mausy%-sz% ! Zeilenzähler = Mausposition
  289.       FOR j1%=1 TO be%          ! Datenfeld ermitteln
  290.         IF zzaehler%=mx%(j1%) THEN ! Mausspalte im Datenfeld?
  291.           j%=j1%                ! ja, Datenfeldnummer setzen
  292.           j1%=be%+1             ! Schleife abbrechen
  293.         ENDIF
  294.       NEXT j1%
  295.       IF mausx%>=my%(j%) AND mausx%<=my%(j%)+td%(j%) THEN
  296.         sp%=mausx%              ! Eingabespalte setzen
  297.       ENDIF
  298.       GOTO daten.eingeben1.1
  299.     ENDIF
  300.     IF x%=65 THEN               ! Cursor hoch
  301.       DEC j%
  302.     ELSE IF x%=66 OR x%=13      ! Cursor runter
  303.       INC j%
  304.     ENDIF
  305.   UNTIL x%=13 AND j%=be%+1 OR x%=27 ! Schleifenabbruch
  306.   um%=be%                       ! Menü auf Ende schalten
  307. RETURN
  308. PROCEDURE daten.loeschen        ! Datensatz löschen
  309.   programmfuss
  310.   aw%=2
  311.   abfrage.ja
  312.   IF y$="J" THEN
  313.     rn%=rc%(i%)                 ! Zeiger auf Record merken
  314.     FOR j%=1 TO be%             ! Datensatz löschen
  315.       te$(j%)=SPACE$(td%(j%))
  316.     NEXT j%
  317.     satz.schreiben              ! Datensatz schreiben
  318.     DELETE a$(i%)               ! Indexeintrag löschen
  319.     DELETE rc%(i%)              ! Zeiger auf Datensatz löschen
  320.     INSERT rc%(1)=rn%           ! Zeiger auf Datensatz einfügen
  321.     INSERT a$(1)=te$(id%(0))
  322.     sortflag%=1                 ! Flag für sortierte Datei setzen
  323.   ENDIF
  324.   um%=9                         ! auf Tabelle schalten
  325.   x%=13                         ! RETURN für Bestätigung
  326. RETURN
  327. PROCEDURE daten.pflege          ! tabellarische Datenpflege
  328. RETURN
  329. PROCEDURE daten.suchen          ! Datensatz über Index suchen
  330.   sortieren                     ! Datei eventuell sortieren
  331.   maske.einblenden
  332.   PRINT AT(4,31);"Suchbegriff eingeben. Zeichen hinterm '*' werden ignoriert. Esc = Abbruch."
  333.   su$=LEFT$(su$+SPACE$(td%(id%(0))),td%(id%(0)))
  334.   eingabe(1,sz%+mx%(id%(0)),my%(id%(0)),il%,su$)
  335.   v%=INSTR(tx$,"*")
  336.   IF x%<>27
  337.     IF v%>1 THEN
  338.       su$=LEFT$(tx$,v%-1)
  339.     ELSE
  340.       su$=tx$                   ! Suchstring
  341.     ENDIF
  342.     ls%=LEN(su$)                ! Länge des Suchstrings
  343.     suchen                      ! Such-Routine
  344.     IF in%=0 THEN               ! Eintrag nicht gefunden
  345.       PRINT AT(4,31);SPACE$(74)
  346.       PCOLOR 6,0
  347.       PRINT AT(4,31);"Eintrag nicht gefunden.";
  348.       PCOLOR 1,0
  349.       PRINT "  Menüpunkt mit Maus auswählen und bestätigen."
  350.       taste
  351.     ELSE
  352.       WHILE LEFT$(a$(in%-1),ls%)=su$
  353.         DEC in%                 ! rückwärts suchen
  354.       WEND
  355.       i%=in%                    ! Zeiger auf Datensatz
  356.       IF tx%>ez% THEN           ! mehr als 21 Datensätze vorhanden?
  357.         um%=9                   ! ja, dann auf Tabelle schalten
  358.       ELSE
  359.         um%=3                   ! nein, dann auf ändern schalten
  360.         satz.lesen              ! Datensatz lesen
  361.         daten.zeigen            ! Datensatz anzeigen
  362.         menÜausgeben            ! Datenpflegemenü aktualisieren
  363.         x%=13
  364.       ENDIF
  365.     ENDIF
  366.   ENDIF
  367. RETURN
  368. PROCEDURE daten.zeigen          ! Datensatz in Maske ausgeben
  369.   PRINT AT(2,2);SPACE$(76)
  370.   PRINT AT(2,2);"Interner Eintrag: ";i%
  371.   PRINT AT(27,2);"Record in der Datei: ";rn%
  372.   PRINT AT(55,2);"Letzter Eintrag: ";n%
  373.   maske.einblenden
  374.   FOR j%=1 TO be%
  375.     daten.zeigen1
  376.   NEXT j%
  377. RETURN
  378. PROCEDURE daten.zeigen1         ! Datenfeld in Maske ausgeben
  379.   IF j%=id%(0) THEN
  380.     PCOLOR 6,0                  ! Indexfeld farbig darstellen
  381.     PRINT AT(my%(j%)-1-LEN(td$(j%)),sz%+mx%(j%));td$(j%)
  382.     PCOLOR 1,0                  ! wieder normale Farbe einschalten
  383.   ENDIF
  384.   PRINT AT(my%(j%)+1,sz%+mx%(j%));te$(j%)
  385. RETURN
  386. PROCEDURE daten.zeigen2         ! 20 Datensätze auf Bildschirm
  387.   programmkopf
  388.   PCOLOR 6,0
  389.   LOCATE 1,sz%
  390.   FOR j1%=lgr% TO rgr%          ! Datenfeldnamen anzeigen
  391.     PRINT dr$(j1%);SPC(td%(j1%)-LEN(dr$(j1%))+1);
  392.   NEXT j1%
  393.   PCOLOR 1,0
  394.   CLR zzaehler%                 ! Zeilenzähler zurcksetzen
  395.   FOR i%=i% TO i%+ez%-1         ! 20 Datensätze ab Indexzähler ausgeben
  396.     satz.lesen                  ! Datensatz lesen
  397.     INC zzaehler%
  398.     LOCATE 1,sz%+zzaehler%
  399.     FOR j1%=lgr% TO rgr%        ! Datensatz anzeigen
  400.       PRINT te$(j1%);" ";
  401.     NEXT j1%
  402.   NEXT i%
  403.   zzaehler%=1
  404.   SUB i%,ez%                    ! minus Anzahl der Maskenzeilen
  405. RETURN
  406. PROCEDURE daten.zeigen3         ! 20 Datensätze links/rechts verschieben
  407.   j%=1
  408.   in%=i%                          ! Zeiger auf aktuellem Datensatz merken
  409.   i%=ii%                          ! 1. Datensatz auf dem Bildschirm
  410.   zz%=zzaehler%                   ! Zeilenzähler merken
  411.   position                      ! Feldposition berechnen
  412.   daten.zeigen2                 ! 20 Datensätze ausgeben
  413.   ii%=i%                          ! Bildschirmzeile für Mausteuerung zurückholen
  414.   i%=in%                          ! Datensatzzeiger zurückholen
  415.   zzaehler%=zz%                   ! aktuelle Bildschirmzeile zurückholen
  416. RETURN
  417. PROCEDURE datenpflege           ! Datenpflege-Menü
  418.   IF dimflag%=0 THEN            ! Datei schon ausgewählt
  419.     daten.bereitst
  420.   ENDIF
  421.   vf.flag%=1                    !
  422.   cf%=1                         ! Cursor- und Maussteuerung erlaubt
  423.   oeffne.r                      ! Datenbank oeffnen
  424.   programmkopf
  425.   datenpflege.start:
  426.   CLR mausk%
  427.   sortieren
  428.   aw%=18                        ! Anweisung Nr. 18
  429.   menÜkontrolle1
  430.   datenpflege.start1:
  431.   CLR mausk%
  432.   SELECT um%
  433.   CASE 1
  434.     daten.eingeben
  435.   CASE 2
  436.     CLR vf.flag%                 ! Vorgabeflag zurücksetzen
  437.     daten.suchen
  438.     vf.flag%=1                   ! Vorgabeflag setzen
  439.   CASE 3
  440.     daten.aendern
  441.   CASE 4
  442.     daten.loeschen
  443.   CASE 5
  444.     i%=1                         ! Zeiger auf 1. Datensatz
  445.     blaettern
  446.   CASE 6
  447.     DEC i%
  448.     blaettern
  449.   CASE 7
  450.     INC i%
  451.     blaettern
  452.   CASE 8
  453.     i%=tx%                      ! Zeiger auf letzten Datensatz
  454.     blaettern
  455.   CASE 9                        ! tabellarische Datenpflege
  456.   CASE 10
  457.     GOTO datenpflege.ende
  458.   ENDSELECT
  459.   GOTO datenpflege.start
  460.   datenpflege.ende:
  461.   sortieren                     ! prüfen ob Datei sortiert werden muß
  462.   CLR cf%                       ! Cursorsteuerung abschalten
  463.   CLR vf.flag%                  ! Vorgabeprüfung abschalten
  464.   CLOSE
  465. RETURN
  466. PROCEDURE deutsch(text1$)       ! deutsche Sprachausgabe
  467.   IF dial% THEN                 ! Dialogaufzeichnis ist eingeschaltet
  468.     PRINT #2,text1$;" ";TRIM$(te$(1));" ";te$(3)  ! Eingabe in Datei schreiben
  469.     PRINT #2,STRING$(79,"-")    !
  470.   ENDIF
  471.   mw%=80
  472.   mm%=mw%/2
  473.   lg1%=LEN(text1$)              ! Länge des Anweisungstextes
  474.   pp%=(mw%-lg1%)\2
  475.   a1$=text1$
  476.   textstil(2,1,0)
  477.   PRINT AT(4,10);SPACE$(75)
  478.   PRINT AT(4,11);SPACE$(75)
  479.   IF lg1%>70 THEN               ! Textlänge mehr als 70 Zeichen?
  480.     v%=RINSTR(70,a1$," ")       ! ja, dann Leerzeichen suchen
  481.     IF v% THEN
  482.       PRINT AT(4,10);LEFT$(a1$,v%)      ! Text für 2 Zeilen splitten
  483.       PRINT AT(4,11);MID$(a1$,v%+1)
  484.     ENDIF
  485.   ELSE
  486.     PRINT AT(4,10);a1$
  487.   ENDIF
  488.   IF sprache% THEN              ! Sprachausgabe eingeschaltet?
  489.     text$=""                    !  alten Phonemtext löschen
  490.     t$=" "+UPPER$(text1$)+" "   !  Text in Großbuchstaben wandeln
  491.     FOR i4%=1 TO LEN(t$)
  492.       aa=ASC(MID$(t$,i4%,1))
  493.       IF aa>=44 AND aa<=57 THEN !  Betonungszeichen übernehmen
  494.         text$=text$+MID$(t$,i4%,1)
  495.       ELSE
  496.         aa=aa-abz%
  497.         IF aa=-32 OR aa>90-abz% THEN
  498.           anpassen1             !  Umlaute anpassen
  499.           aa=ASC(MID$(t$,i4%,1))-abz%
  500.         ENDIF
  501.         IF aa>=0 AND aa<=abz% THEN
  502.           IF n5%(aa) THEN       !  Anzahl der Phoneme für ein Zeichen
  503.             FOR j4%=1 TO n5%(aa)
  504.               IF MID$(t$,i4%,LEN(te1$(aa,j4%)))=te1$(aa,j4%) THEN
  505.                 text$=text$+ph$(aa,j4%)
  506.                 i4%=i4%+LEN(te1$(aa,j4%))-1
  507.                 j4%=n5%(aa)
  508.               ENDIF
  509.             NEXT j4%
  510.           ENDIF
  511.         ENDIF
  512.       ENDIF
  513.     NEXT i4%
  514.     SAY text$,akt1%()             !  Text sprechen
  515.   ENDIF
  516. RETURN
  517. PROCEDURE dialog                ! Dialog mit dem Amiga
  518.   daten.bereitst
  519.   programmfuss
  520.   IF dial% THEN
  521.     x$=TIME$
  522.     v%=RINSTR(x$,":")
  523.     IF v% THEN
  524.       x$=MID$(x$,v%+1)
  525.     ENDIF
  526.     x$=DATE$+"."+x$
  527.     OPEN "O",#2,pfad$(0)+dateiname$+" "+x$
  528.   ENDIF
  529.   deutsch("Hallo, ich heiße Amiga, und Du?")
  530.   lg%=15
  531.   t$=SPACE$(lg%)
  532.   eingabe(1,31,4,lg%,t$)
  533.   sp$=TRIM$(tx$)                ! Spielernamen merken
  534.   IF sp$="" THEN
  535.     sp$="Partner"
  536.   ENDIF
  537.   oeffne.r                      ! Wortschatzdatei öffnen
  538.   CLR abbruch%                  ! Abbruchflag loeschen
  539.   lg%=70                        ! Länge der Eingabe
  540.   t$="Hallo, "+sp$+" erzähle mir etwas von Dir und Deiner Familie."
  541.   WHILE abbruch%=0
  542.     programmfuss
  543.     anweisung(7)
  544.     deutsch(t$)
  545.     t$=SPACE$(lg%)
  546.     eingabe(1,18,4,lg%,t$)
  547.     e$=TRIM$(tx$)
  548.     IF dial% THEN               ! Dialogaufzeichnis ist eingeschaltet
  549.       PRINT #2,e$               ! Eingabe in Datei schreiben
  550.     ENDIF
  551.     IF UPPER$(e$)<>"QUIT" THEN
  552.       zeile.zerlegen            ! Eingabe des Gesprächpartner zerlegen
  553.       IF w%>1 THEN              ! mehr als 2 Worte eingegeben?
  554.         ig%=0                   ! Anzahl der Schlüsselworte löschen
  555.         CLR ii%
  556.         WHILE ii%<w%
  557.           INC ii%
  558.           su$=UPPER$(e$(ii%))   ! Suchwort
  559.           suchen1               ! Wort suchen
  560.           IF in% THEN           ! Wort gefunden
  561.             WHILE UPPER$(TRIM$(a$(in%-1)))=su$ ! Bereichsanfang rückwärts suchen
  562.               DEC in%           ! Zähler -1
  563.             WEND
  564.             WHILE UPPER$(TRIM$(a$(in%)))=su$  ! vorwärts suchen
  565.               IF z%(in%)=0 THEN ! Schlüsselwort noch nicht benutzt
  566.                 INC ig%         ! Zähler erhöhen
  567.                 in%(ig%,0)=ii%  ! Wortnummer merken
  568.                 in%(ig%,1)=in%  ! Recordnummer merken
  569.               ENDIF
  570.               INC in%
  571.             WEND
  572.           ENDIF
  573.         WEND
  574.         IF ig%=0 AND frage%=1 THEN
  575.           verlegenheitsfrage    ! Verlegenheitsfrage suchen
  576.           antwort.suchen        ! noch nicht benutzten Text suchen
  577.           IF ok%=0 THEN         ! keine Verlegenheitsfrage mehr vorhanden
  578.             t$="Nun muß ich aber Schluß machen. Tschüss."
  579.             deutsch(t$)
  580.             abbruch%=1          ! Programm abbrechen
  581.           ENDIF
  582.         ELSE                    ! Dialog ohne Fragestellung
  583.           antwort.suchen        ! Antwort oder Textkomposition suchen
  584.           IF ok%=0 THEN         ! nichts gefunden, dann
  585.             textkomposition     ! Text umbauen
  586.             IF ok%=0 THEN       ! nicht möglich, dann
  587.               verlegenheitsfrage  ! Verlegenheitsfrage suchen
  588.               antwort.suchen    ! noch nicht benutzten Text suchen
  589.               IF ok%=0 THEN     ! keine Verlegenheitsfrage mehr gefunden
  590.                 t$="Nun muß ich aber Schluß machen. Tschüss."
  591.                 deutsch(t$)
  592.                 abbruch%=1      ! Programm abbrechen
  593.               ENDIF
  594.             ENDIF
  595.           ENDIF
  596.         ENDIF
  597.       ELSE IF w%<2              ! weniger als 2 Worte eingeben
  598.         t$="Mach gefälligst einen anständigen Satz."
  599.       ENDIF
  600.     ELSE
  601.       CLOSE                     ! alle Dateien schließen
  602.       abbruch%=1                ! Abbruchflag bei 'QUIT' setzen
  603.       ERASE z%()                ! Feld mit den Flags löschen
  604.       DIM z%(mg1%+10)           !
  605.     ENDIF
  606.   WEND
  607.   CLOSE                         ! alle Dateien schließen
  608. RETURN
  609. PROCEDURE druckfeldname         ! Feldnamen für Liste drucken
  610.   FOR jj%=1 TO mz%
  611.     FOR j%=1 TO be%
  612.       IF pt%(j%)>0 THEN         ! Datenfeld ausgeben
  613.         PRINT #2,dr$(pt%(j%));SPC(td%(pt%(j%))-LEN(dr$(pt%(j%)))+1);
  614.       ENDIF
  615.     NEXT j%
  616.   NEXT jj%
  617. RETURN
  618. PROCEDURE eingabe(sp%,zeile%,spalte%,lg%,t$)
  619.   undo1$=t$                     ! Eingabe sichern
  620.   eingabe0:
  621.   PRINT AT(spalte%+1,zeile%);t$ ! String auf Bildschirm
  622.   eingabe1:
  623.   IF sp%<1 THEN                 ! Spalte < 1
  624.     sp%=1                       ! ja, dann Spalte = 1
  625.   ELSE IF sp%>lg%               ! Spalte > Stringlaenge
  626.     sp%=lg%                     ! ja, dann Spalte = Stringlaenge
  627.   ENDIF
  628.   LOCATE spalte%+sp%,zeile%        ! Cursor positionieren
  629.   textstil(7,3,6)               ! Invers an
  630.   PRINT MID$(t$,sp%,1)          ! Zeichen ausgeben
  631.   textstil(0,1,0)               ! Invers aus
  632.   taste                         ! Zeichen von Tastatur holen
  633.   IF mausy%>0 THEN              ! mit Maus positioniert
  634.     cursor.aus                  ! Ersatz-Cursor aus
  635.     IF (cf% AND mausy%<>zeile%) OR (cf% AND mausx%<spalte%) OR (cf% AND mausx%>spalte%+lg%) THEN
  636.       GOTO eingabe.ende         ! ja, dann Ende
  637.     ELSE
  638.       sp%=mausx%-spalte%        ! Spaltenposition = Mausspalte-Spalte
  639.     ENDIF
  640.   ENDIF
  641.   IF cf%=1 THEN                 ! Datenfeld links/rechts
  642.     IF x%=12 OR x%=18 OR x%=20 OR x%=22 THEN      !
  643.       GOTO eingabe.ende
  644.     ENDIF
  645.   ENDIF
  646.   IF x%=13 OR x%=27 THEN        ! Abbbruch durch Esc oder RETURN?
  647.     GOTO eingabe.ende
  648.   ELSE IF x%=155                ! Sondertasten
  649.     x%=ASC(MID$(x$,2,1))        ! ASCII-Wert
  650.     cursor.aus                  ! Ersatz-Cursor ausschalten
  651.     IF x%=65 AND cf%=1 OR x%=66 AND cf%=1 THEN ! Abbbruch
  652.       GOTO eingabe.ende
  653.     ENDIF
  654.     IF x%=63 THEN               ! HELP-Taste
  655.     ELSE IF x%=67               ! Cursor rechts
  656.       INC sp%                   ! ja, dann Spalte +1
  657.     ELSE IF x%=68               ! Cursor links
  658.       DEC sp%                   ! ja, dann Spalte -1
  659.     ELSE IF x%=90               ! TAB links
  660.       sp%=sp%-8                 ! Spalte -8
  661.     ENDIF
  662.   ELSE IF x%=127                !   Delete
  663.     t$=LEFT$(t$,sp%-1)+MID$(t$,sp%+1,lg%-sp%)+" " ! Zeichen löschen
  664.   ELSE IF x%<32 OR x%>127 AND x%<160  ! Steuerzeichen?
  665.     cursor.aus
  666.     IF x%=8 AND sp%>1 THEN      ! Backspace
  667.       t$=LEFT$(t$,sp%-2)+MID$(t$,sp%,lg%-sp%+1)+" " ! Leerzeichen einfügen
  668.       sp%=sp%-1                 ! Spalte -1
  669.     ELSE IF x%=4                ! Ctrl-d
  670.       t$=SPACE$(lg%)            ! ja, dann String löschen
  671.     ELSE IF x%=9                ! TAB rechts
  672.       sp%=sp%+8                 ! ja, dann Spalte +8
  673.     ELSE IF x%=16               ! Crtl-p
  674.       auto.insert%=NOT auto.insert% ! ja, dann Insertflag ändern
  675.       CLR x%                    ! Steuerzeichen löschen
  676.       IF auto.insert%=0 THEN
  677.         PRINT AT(2,29);"Insert aus"
  678.       ELSE
  679.         PRINT AT(2,29);"Insert an "
  680.       ENDIF
  681.     ELSE IF x%=21               ! Ctrl-u = Feld einfügen
  682.       t$=LEFT$(undo$+SPACE$(lg%),lg%) ! Text aus Puffer auf Sollänge bringen
  683.     ELSE IF x%=25               ! Ctrl-y = Feld löschen
  684.       undo$=t$                  ! Text zwischenspeichern
  685.       t$=SPACE$(lg%)            ! String löschen
  686.       sp%=1                     ! Spalte = 1
  687.     ENDIF
  688.   ELSE                          ! gültiges ASCII-Zeichen übernehmen
  689.     IF auto.insert% THEN        ! Einfügemodus eingeschaltet?
  690.       t$=LEFT$(t$,sp%-1)+x$+MID$(t$,sp%,lg%-sp%) ! ja, dann Zeichen einfügen
  691.     ELSE                        ! Überschreibmodus
  692.       MID$(t$,sp%,1)=x$         ! Zeichen überschreiben
  693.     ENDIF
  694.     INC sp%                     ! Spalte +1
  695.   ENDIF
  696.   GOTO eingabe0
  697.   eingabe.ende:
  698.   cursor.aus                    ! Ersatz-Cursor ausschalten
  699.   tx$=t$                        ! Rückgabestring an die aufrufende Procedure
  700.   sp1%=sp%
  701. RETURN
  702. PROCEDURE einsortieren          ! Datensatz einsortieren
  703.   ls%=il%                        ! Vergleichslänge = Indexlänge
  704.   su$=a$(i%)                    ! Suchstring übergeben
  705.   rc%(0)=rc%(i%)                ! Datensatzzeiger merken
  706.   DELETE a$(i%)                 ! Eintrag löschen
  707.   DELETE rc%(i%)                ! Eintrag löschen
  708.   DEC tx%                       ! interner Zähler -1 (für Suchroutine)
  709.   suchen                        ! Eintrag suchen
  710.   INC tx%                       ! internen Zähler korrigieren
  711.   IF in%=0 THEN                 ! kein Eintrag gefunden?
  712.     IF su$>a$(i3%) THEN         ! Vergleichsstring > Eintrag
  713.       INSERT a$(i3%+1)=su$      ! ja, dann dahinter einfügen
  714.       INSERT rc%(i3%+1)=rc%(0)  ! Recordnummer einfuegen
  715.     ELSE
  716.       INSERT a$(i3%)=su$        ! nein, dann davor einfügen
  717.       INSERT rc%(i3%)=rc%(0)    ! Recordnummer einfuegen
  718.     ENDIF
  719.   ELSE
  720.     INSERT a$(in%)=su$          ! beim gefundenen Eintrag einfügen
  721.     INSERT rc%(in%)=rc%(0)      ! Recordnummer einfuegen
  722.   ENDIF
  723.   sortflag%=1                    ! Flag für sortierte Datei
  724. RETURN
  725. PROCEDURE erste.person.ersetzen ! 1. Person durch 2. Person ersetzen
  726.   FOR j%=1 TO w%                ! Anzahl der Worte der Eingabezeile
  727.     e1$(j%)=e$(j%)              ! Wort merken
  728.     IF UPPER$(e$(j%))="ICH" THEN
  729.       e1$(j%)="Du"
  730.     ELSE IF UPPER$(e$(j%))="DU"
  731.       e1$(j%)="ich"
  732.     ELSE IF UPPER$(e$(j%))="MICH"
  733.       e1$(j%)="Dich"
  734.     ELSE IF UPPER$(e$(j%))="DICH"
  735.       e1$(j%)="mich"
  736.     ELSE IF UPPER$(e$(j%))="MEIN"
  737.       e1$(j%)="Dein"
  738.     ELSE IF UPPER$(e$(j%))="MEINE"
  739.       e1$(j%)="Deine"
  740.     ELSE IF UPPER$(e$(j%))="MEINER"
  741.       e1$(j%)="Deiner"
  742.     ELSE IF UPPER$(e$(j%))="DEIN"
  743.       e1$(j%)="mein"
  744.     ELSE IF UPPER$(e$(j%))="DEINE"
  745.       e1$(j%)="meine"
  746.     ELSE IF UPPER$(e$(j%))="MIR"
  747.       e1$(j%)="Dir"
  748.     ELSE IF UPPER$(e$(j%))="DIR"
  749.       e1$(j%)="mir"
  750.     ELSE IF UPPER$(e$(j%))="WIR"
  751.       e1$(j%)="ihr"
  752.     ENDIF
  753.   NEXT j%
  754. RETURN
  755. PROCEDURE fehler
  756.   IF ERR=8 THEN
  757.     fehler.anzeigen("Speichermangel. Unnötige Programme beenden.")
  758.   ELSE IF ERR=-51               ! Datei kann nicht geöffnet werden
  759.     CLOSE
  760.     fehler.anzeigen("Keine Maske und/oder Datei für dieses Programm.")
  761.     RESUME start
  762.   ENDIF
  763.   fehler.anzeigen(" gemäß Handbuch: ")
  764.   RESUME start
  765. RETURN
  766. PROCEDURE fehler.anzeigen(f$)
  767.   programmfuss
  768.   PCOLOR 3,0
  769.   PRINT AT(4,31);"Fehler-Nr.: ";
  770.   PCOLOR 1,0
  771.   PRINT ERR;"  ";
  772.   PCOLOR 3,0
  773.   PRINT f$
  774.   PCOLOR 1,0
  775.   CLOSE
  776.   GOSUB tastendruck
  777. RETURN
  778. PROCEDURE fusszeile             ! Fußzeile für Listendruck
  779.   IF gadr%<>3 THEN
  780.     PRINT #2,SPC((zbreite%-LEN(text$(2)))/2);text$(2)
  781.   ELSE
  782.     PRINT #2,LEFT$(text$(2),le%)
  783.   ENDIF
  784.   trennzeile
  785.   IF vorschub%>0 THEN
  786.     FOR j%=1 TO vorschub%
  787.       PRINT #2
  788.     NEXT j%
  789.   ENDIF
  790. RETURN
  791. PROCEDURE index.ein
  792.   anweisung(21)                 ! Namen der Arbeitsdatei
  793.   anweisung(33)                 ! Ordner sind mit...
  794.   maske.einlesen
  795.   IF abbruch%=0 THEN            ! nur ausführen wenn Dateiname eingegeben
  796.     CLR tx%                     ! Indexeinträge löschen
  797.     oeffne.i                    ! Dateigröße feststellen
  798.     indexwahl
  799.     mg1%=4000                   ! maximale Einträge
  800.     IF pwd%=1 THEN              ! Passwort vorhanden
  801.       mg%=mg1%
  802.     ELSE
  803.       mg%=300                   ! kein Paßwort vorhanden
  804.     ENDIF
  805.     ERASE a$(),rc%(),z%()
  806.     DIM a$(mg1%+10),rc%(mg1%+10),z%(mg1%+10)! etwas Reserve
  807.     dimflag%=1
  808.     IF pwd%=0 AND n%>300 THEN
  809.       passwort                  ! Paßwort abfragen
  810.     ENDIF
  811.   ENDIF
  812. RETURN
  813. PROCEDURE indexwahl
  814.   id%(0)=1                      ! dann Feld 1 als Index markieren
  815.   FOR j%=1 TO be%
  816.     te$(j%)=SPACE$(td%(j%))     ! Felder loeschen
  817.   NEXT j%
  818.   CLR sortflag%                 ! Datei als unsortiert kennzeichnen
  819.   indexflag%=1                  ! Index vorhanden
  820.   index.pos                     ! Feldpositon feststellen
  821.   il%=td%(id%(0))               ! Anzahl der Zeichen für Indexdatei
  822. RETURN
  823. PROCEDURE index.pos             ! Feldposition feststellen
  824.   po%(1)=1
  825.   FOR j%=1 TO be%               ! Bildschirmpos. der Datenfelder berechnen
  826.     pt%(j%)=j%
  827.     po%(j%+1)=po%(j%)+td%(j%)
  828.   NEXT j%
  829. RETURN
  830. PROCEDURE kopfzeile             ! Kopfzeilen für Listendruck
  831.   PRINT #2,text$(1);SPC(zbreite%-11-LEN(text$(1)));
  832.   PRINT #2,datum$;
  833.   PRINT #2,
  834.   sternzeile
  835. RETURN
  836. PROCEDURE lese.umenue(un%)
  837.   FOR jj%=1 TO un%
  838.     READ uy%(jj%),ux%(jj%),ux$(jj%)
  839.   NEXT jj%
  840. RETURN
  841. PROCEDURE maske.einblenden
  842.   LOCATE 1,sz%+1
  843.   FOR j2%=1 TO ez%
  844.     PRINT m$(j2%)
  845.   NEXT j2%
  846. RETURN
  847. PROCEDURE maske.einlesen        ! Maske vom Datenträger lesen
  848.   programmname
  849.   IF abbruch%=0 THEN
  850.     OPEN "i",#1,pfad$(x2%)+maske$(x2%)
  851.     INPUT #1,ms%,be%,le%,dl%,dz%
  852.     FOR j%=1 TO ez%
  853.       LINE INPUT #1,m$(j%)
  854.       INPUT #1,mx%(j%),my%(j%)
  855.     NEXT j%
  856.     FOR j%=1 TO fz%
  857.       LINE INPUT #1,dr$(j%)
  858.       LINE INPUT #1,td$(j%)
  859.       LINE INPUT #1,tv$(j%)
  860.       INPUT #1,td%(j%)
  861.     NEXT j%
  862.     LINE INPUT #1,text$(1)
  863.     LINE INPUT #1,text$(2)
  864.     INPUT #1,druckzeilen%
  865.     INPUT #1,vorschub%
  866.     INPUT #1,dummy%
  867.     FOR j%=1 TO zmenue%
  868.       LINE INPUT #1,menue$(menue%+j%) ! zusätzliche Menüs
  869.       LINE INPUT #1,zpfad$(j%)  ! Pfad zum Ausführen der Menüpunkte (Prg.)
  870.     NEXT j%
  871.     CLOSE
  872.   ENDIF
  873.   dl%=le%-1+be%-1               ! Druckbreite
  874. RETURN
  875. PROCEDURE maus.kontrolle
  876.   WHILE MOUSEK<>0               ! linken Mausknopf gedrueckt?
  877.     mausx%=MOUSEX               ! Rechtswert Mauskoordinaten sichern
  878.     mausy%=MOUSEY               ! Hochwert der Maus
  879.     FOR i4%=0 TO 7
  880.       IF mausx%>=x2(i4%) AND mausx%=<x3(i4%) THEN
  881.         IF mausy%>=y1(i4%) AND mausy%=<y2(i4%) THEN
  882.           v=(mausx%-x2(i4%))/(x3(i4%)-x2(i4%))
  883.           IF i4%=1 OR i4%=3 OR i4%=7 THEN
  884.             IF v>0.5 THEN
  885.               v=1
  886.             ELSE
  887.               CLR v
  888.             ENDIF
  889.           ENDIF
  890.           akt1%(i4%)=mi(i4%)+v*(ma(i4%)-mi(i4%))
  891.           zeichne.boxen         !  Kontrollbox zeichnen
  892.         ENDIF
  893.       ENDIF
  894.     NEXT i4%
  895.   WEND
  896. RETURN
  897. PROCEDURE menÜausgeben          ! Datenpflegemenü anzeigen
  898.   IF um%<1 OR um%>un% THEN      ! Menüpunkt außerhalb des Bereiches
  899.     um%=1                       ! ja, dann Menuepunkt = 1
  900.   ENDIF
  901.   COLOR 4                       ! hellgrau
  902.   LINE 16,(28*8)-12,633-12,(28*8)-12  !  Linie
  903.   COLOR 2
  904.   LINE 16,(28*8)+2,633-12,(28*8)+2
  905.   FOR jj%=1 TO un%              ! Menüs anzeigen
  906.     COLOR 4                     ! hellgrau
  907.     LINE uy%(jj%)*8-12,ux%(jj%)*8-12,uy%(jj%)*8-12,ux%(jj%)*8+1
  908.     PCOLOR 6,0
  909.     PRINT AT(uy%(jj%),ux%(jj%));ux$(jj%)
  910.     PCOLOR 1,0
  911.   NEXT jj%
  912.   LOCATE uy%(um%),ux%(um%)
  913.   textstil(7,3,6)               ! Menüpunkt invers darstellen
  914.   PRINT ux$(um%)
  915.   textstil(0,1,0)               ! Invers aus
  916. RETURN
  917. PROCEDURE menÜkontrolle         ! Hauptmenü
  918.   mn%=MENU(0)                   ! Menüpunkt
  919.   SELECT mn%
  920.   CASE 1
  921.     info
  922.   CASE 2
  923.     dialog
  924.   CASE 3
  925.     datenpflege
  926.   CASE 4
  927.     beenden
  928.   CASE 7
  929.     sprache%=NOT sprache%       ! Flag invertieren
  930.     IF sprache% THEN
  931.       MENU 7,&H153              ! Haken entfernen
  932.     ELSE
  933.       MENU 7,&H53               ! Menüpunkt abhaken
  934.     ENDIF
  935.   CASE 8
  936.     spracheinstellung
  937.   CASE 9
  938.     lern%=NOT lern%             ! Flag invertieren
  939.     IF lern% THEN
  940.       MENU 9,&H153              ! Haken entfernen
  941.     ELSE
  942.       MENU 9,&H53               ! Menüpunkt abhaken
  943.     ENDIF
  944.   CASE 10
  945.     dial%=NOT dial%             ! Flag invertieren
  946.     IF dial% THEN
  947.       MENU 10,&H153             ! Haken entfernen
  948.     ELSE
  949.       MENU 10,&H53              ! Menüpunkt abhaken
  950.     ENDIF
  951.   CASE 13                       ! Worschatz drucken
  952.     IF tx%>0 THEN
  953.       gadr%=4
  954.       verzeichnis.aus
  955.     ELSE
  956.       daten.bereitst
  957.     ENDIF
  958.   CASE 14                       ! Wortschatz in Datei
  959.     IF tx%>0 THEN
  960.       gadr%=1
  961.       verzeichnis.aus
  962.     ELSE
  963.       daten.bereitst
  964.     ENDIF
  965.   ENDSELECT
  966.   programmkopf
  967.   anweisung(27)
  968. RETURN
  969. PROCEDURE menÜkontrolle1        ! Datenpflegemenü
  970.   anweisung(aw%)
  971.   WHILE mausk%<>2 AND x%<>13
  972.     menÜausgeben
  973.     taste
  974.     IF mausy%=28 THEN
  975.       menÜnummer
  976.     ELSE IF x%<>13
  977.       x%=ASC(MID$(x$,2,1))-37
  978.       IF x%=30                  ! Cursor rechts
  979.         INC um%
  980.       ELSE IF x%=31             ! Cursor links
  981.         DEC um%
  982.       ENDIF
  983.       IF um%<1 THEN
  984.         um%=un%
  985.       ELSE IF um%>un%
  986.         um%=1
  987.       ENDIF
  988.     ENDIF
  989.     FOR j1%=1 TO un%
  990.       IF LEFT$(x$,1)=MID$(ux$(j1%),1,1) THEN
  991.         um%=j1%
  992.       ENDIF
  993.     NEXT j1%
  994.   WEND
  995.   CLR x%
  996. RETURN
  997. PROCEDURE menÜnummer            ! Menünummer des angekl. Menüpkt. berechn.
  998.   FOR jj%=1 TO un%
  999.     IF mausx%>=uy%(jj%) AND mausx%<=uy%(jj%)+LEN(ux$(jj%)) THEN ! Spalte
  1000.       um%=jj%
  1001.     ENDIF
  1002.   NEXT jj%
  1003. RETURN
  1004. PROCEDURE oeffne.a              ! Datei zum Anfügen öffnen
  1005.   OPEN "a",#2,pfad$(x2%)+d$(x2%)
  1006. RETURN
  1007. PROCEDURE oeffne.i              ! Dateigröße feststellen
  1008.   OPEN "I",#1,pfad$(x2%)+d$(x2%)
  1009.   lo%=LOF(#1)                   ! Dateigröße
  1010.   n%=lo%/le%                    ! Anzahl der gespeicherten Datensätze
  1011.   CLOSE #1                      ! Datei schließen
  1012. RETURN
  1013. PROCEDURE oeffne.r              ! Relative Datei öffnen
  1014.   OPEN "R",#1,pfad$(x2%)+d$(x2%),le%
  1015.   FIELD #1,(le%) AS record$
  1016. RETURN
  1017. PROCEDURE passwort              ! Paßwortabfrage
  1018.   pwd%=1
  1019. RETURN
  1020. PROCEDURE position              ! Ausgabespalten berechnen
  1021.   sl%=1
  1022.   feldp%(lgr%)=1
  1023.   FOR j1%=1 TO rgr%-lgr%+1
  1024.     feldp%(j1%+1)=sl%+td%(lgr%+j1%-1)
  1025.     sl%=sl%+td%(lgr%+j1%-1)
  1026.   NEXT j1%
  1027. RETURN
  1028. PROCEDURE programmkopf
  1029.   CLS
  1030.   COLOR 2                       ! schwarze Box
  1031.   PBOX 1,1,639,20
  1032.   COLOR 0                       ! grau
  1033.   PBOX 6,4,633,17
  1034.   COLOR 4                       ! hellgrau
  1035.   LINE 6,4,633,4
  1036.   LINE 6,4,6,17
  1037.   PRINT AT(2,2);SPACE$(78)
  1038.   PCOLOR 6,0
  1039.   PRINT AT(2,2);"Prg.:";dateiname$
  1040.   PRINT AT(21,2);"Frei:";FRE(0)
  1041.   PRINT AT(34,2);"Größe:";lo%
  1042.   PRINT AT(47,2);"Extern: ";n%
  1043.   PRINT AT(65,2);"Intern: ";tx%
  1044.   PCOLOR 1,0
  1045.   programmfuss
  1046. RETURN
  1047. PROCEDURE programmauswahl(titel$,oktext$,VAR pfad$,dateiname$)
  1048.   FILESELECT titel$,oktext$,pfad$,dateiname$
  1049.   pos1%=RINSTR(dateiname$,"/")
  1050.   pos2%=RINSTR(dateiname$,":")
  1051.   IF pos1%>0 THEN               ! Dateipfad herausfiltern
  1052.     pfad$=MID$(dateiname$,1,pos1%)
  1053.     dateiname$=MID$(dateiname$,pos1%+1)
  1054.   ELSE IF pos2%>1 AND pos1%=0   ! Laufwerk nach Drive$()
  1055.     pfad$=LEFT$(dateiname$,pos2%)
  1056.     dateiname$=MID$(dateiname$,pos2%+1)
  1057.   ENDIF
  1058. RETURN
  1059. PROCEDURE programmname
  1060.   pfad$=pfad$(x2%)              ! Pfad übergeben für Fileselect
  1061.   IF pfad$="" THEN
  1062.     pfad$=DIR$(0)               ! aktuelles Laufwerk übernehmen
  1063.   ENDIF
  1064.   programmauswahl("Datei auswählen","OK",pfad$,dateiname$)
  1065.   IF dateiname$="" THEN
  1066.     abbruch%=1                  ! Abbruchflag setzen
  1067.   ELSE
  1068.     CLR abbruch%                ! Abbruchflag löschen
  1069.     IF RIGHT$(dateiname$,6)=".Daten" OR RIGHT$(dateiname$,6)=".Maske" THEN
  1070.       dateiname$=LEFT$(dateiname$,LEN(dateiname$)-6)
  1071.     ENDIF
  1072.     d$(x2%)=dateiname$+".Daten" ! Datenbankname
  1073.     maske$(x2%)=dateiname$+".Maske"! Name der Konfigurationsdatei
  1074.   ENDIF
  1075.   pfad$(x2%)=pfad$              ! Pfad sichern für nächstes Fileselect
  1076. RETURN
  1077. PROCEDURE programmfuss          ! Anweisungsboxen zeichnen
  1078.   COLOR 2                       ! schwarz
  1079.   PBOX 1,(27*8)-10,639,(32*8)   ! schwarze Box
  1080.   COLOR 0                       ! grau
  1081.   PBOX 6,(27*8)-7,633,(28*8)+4  ! graue Box
  1082.   PBOX 6,(29*8)+2,633,(32*8)-4  ! 2. graue Box
  1083.   COLOR 4                       ! hellgrau
  1084.   BOX 7,(27*8)-7,633,(32*8)-3
  1085.   LINE 7,(29*8)+2,633,(29*8)+2
  1086.   LINE 16,(29*8)-6,639-16,(29*8)-6
  1087.   LINE 16,(29*8)+5,639-16,(29*8)+5
  1088.   LINE 639-16,(29*8)-6,639-16,(26*8)+4  ! senkrechter Strich
  1089.   LINE 16,(29*8)+5,16,(31*8)+2  ! senkrechter Strich
  1090.   COLOR 2                       ! schwarz
  1091.   LINE 7,(32*8)-3,633,(32*8)-3  ! schwarze Linie
  1092.   LINE 633,(27*8)-7,633,(32*8)-3
  1093.   LINE 16,(27*8)-4,639-16,(27*8)-4
  1094.   LINE 16,(31*8)+2,639-16,(31*8)+2
  1095.   LINE 16,(29*8)-6,16,(26*8)+4  ! senkrechter Strich
  1096.   LINE 639-16,(29*8)+5,639-16,(31*8)+2    ! senkrechter Strich
  1097. RETURN
  1098. PROCEDURE prÜfe.vorgabe         ! Vorgabemaske vergleichen
  1099.   vflag%=1                      ! OK-Flag setzen
  1100. RETURN
  1101. PROCEDURE prÜfe.vorgabe.input(j2%,t$)
  1102.   IF vg%(j2%)=3 THEN             ! Eingabe rechtsbündig
  1103.     tx$=RIGHT$(SPACE$(td%(j2%))+TRIM$(t$),td%(j2%))
  1104.   ENDIF
  1105. RETURN
  1106. PROCEDURE satz.lesen            ! einen Datensatz lesen
  1107.   rn%=rc%(i%)                   ! Recordnummer
  1108.   GET #1,rn%
  1109.   FOR j1%=1 TO be%
  1110.     te$(j1%)=MID$(record$,po%(j1%),td%(j1%))
  1111.   NEXT j1%
  1112. RETURN
  1113. PROCEDURE satz.schreiben        ! Datensatz in Datenbank speichern
  1114.   IF a$(i%)<>te$(id%(0)) THEN      ! wurde der Indexeintrag verändert?
  1115.     a$(i%)=te$(id%(0))             ! ja, dann Eintrag übernehmen
  1116.     CLR sortflag%               ! Datei ist nicht mehr sortiert
  1117.   ENDIF
  1118.   rc$=""                        ! Datensatz löschen
  1119.   FOR j1%=1 TO be%
  1120.     rc$=rc$+te$(j1%)            ! Datensatz zusammensetzen
  1121.   NEXT j1%
  1122.   LSET record$=rc$              ! Datensatz übergeben
  1123.   PUT #1,rn%                    ! und speichern
  1124. RETURN
  1125. PROCEDURE sortieren             ! Index sortieren
  1126.   WHILE sortflag%=0 AND indexflag%=1
  1127.     anweisung(24)
  1128.     QSORT a$(),tx%+1,rc%()
  1129.     sortflag%=1
  1130.     PRINT AT(4,ax%(aw%));SPACE$(74)
  1131.   WEND
  1132. RETURN
  1133. PROCEDURE sp.mangel             ! Speichermangel anzeigen
  1134.   PRINT AT(4,31);SPACE$(74);
  1135.   PCOLOR 6,0
  1136.   PRINT AT(4,31);"Wegen Speichermangel nicht möglich.";
  1137.   PCOLOR 1,0
  1138.   PRINT "Weiter mit RETURN";
  1139.   taste
  1140.   PRINT AT(4,31);SPACE$(74);
  1141.   CLR x%                      ! Zeichen löschen, wir sind im INPUT
  1142. RETURN
  1143. PROCEDURE spracheinstellung
  1144.   programmkopf
  1145.   anweisung(6)
  1146.   zeichne.regler                ! Regler zeichnen
  1147.   mausx%=600                    ! Rechtswert der als Schleifeneingangswert
  1148.   WHILE mausx%>400              !
  1149.     maus.kontrolle              ! zur Mauskontrolle
  1150.   WEND
  1151. RETURN
  1152. PROCEDURE sternzeile
  1153.   PRINT #2,STRING$(zbreite%,"*")
  1154. RETURN
  1155. PROCEDURE suchen                ! Datensatz suchen
  1156.   i1%=1
  1157.   i2%=tx%+1                     ! Anzahl +1 um den letzten Eintrag zu vergleichen
  1158.   in%=-1                        ! Flag
  1159.   WHILE in%=-1
  1160.     i3%=INT((i1%+i2%)/2)        ! Liste halbieren
  1161.     IF su$=LEFT$(a$(i3%),ls%) THEN
  1162.       in%=i3%                   ! gefunden
  1163.     ENDIF
  1164.     IF su$<LEFT$(a$(i3%),ls%) THEN
  1165.       i2%=i3%
  1166.     ELSE
  1167.       i1%=i3%
  1168.     ENDIF
  1169.     IF i3%=INT((i1%+i2%)/2) AND in%=-1 THEN
  1170.       CLR in%                   ! nicht gefunden
  1171.     ENDIF
  1172.   WEND
  1173. RETURN
  1174. PROCEDURE suchen1               ! Datensatz suchen
  1175.   i1%=1
  1176.   i2%=tx%+1                     ! Anzahl +1 um den letzten Eintrag zu vergleichen
  1177.   in%=-1                        ! Flag
  1178.   WHILE in%=-1
  1179.     i3%=INT((i1%+i2%)/2)        ! Liste halbieren
  1180.     IF su$=UPPER$(TRIM$(a$(i3%))) THEN
  1181.       in%=i3%                   ! gefunden
  1182.     ENDIF
  1183.     IF su$<UPPER$(TRIM$(a$(i3%))) THEN
  1184.       i2%=i3%
  1185.     ELSE
  1186.       i1%=i3%
  1187.     ENDIF
  1188.     IF i3%=INT((i1%+i2%)/2) AND in%=-1 THEN
  1189.       CLR in%                   ! nicht gefunden
  1190.     ENDIF
  1191.   WEND
  1192. RETURN
  1193. PROCEDURE tagesdatum
  1194.   programmkopf
  1195.   PRINT AT(20,10);"Tagesdatum: "
  1196.   eingabe(1,10,33,10,DATE$)
  1197.   datum$=tx$
  1198. RETURN
  1199. PROCEDURE taste                 ! ein Zeichen von der Tastatur holen
  1200.   CLR x%                        ! Steuerzeichen löschen
  1201.   CLR mausk%
  1202.   CLR mausx%                    ! Mausspalte löschen
  1203.   CLR mausy%                    ! Mauszeile löschen
  1204.   WHILE x%=0 AND MOUSEK=0
  1205.     x$=INKEY$                   ! Zeichen von Tastatur
  1206.     x%=ASC(x$)                  ! ASCII-Wert für Auswertung
  1207.   WEND
  1208.   IF MOUSEK<>0 THEN             ! linke Maustaste
  1209.     mausx%=INT(MOUSEX/8)+1      ! ja, dann Spalte = mausx
  1210.     mausy%=INT(MOUSEY/8)+1      ! Zeile = mausy
  1211.     mausk%=MOUSEK               ! Maustaste
  1212.   ENDIF
  1213. RETURN
  1214. PROCEDURE tastendruck
  1215.   PRINT AT(4,28);SPACE$(74);
  1216.   PCOLOR 6,0
  1217.   PRINT AT(18,28);" Weiter mit beliebiger Taste oder Mausklick."
  1218.   GOSUB taste
  1219.   PCOLOR 1,0
  1220.   PRINT AT(4,28);SPACE$(74)
  1221. RETURN
  1222. PROCEDURE textkomposition       !
  1223.   CLR x%
  1224.   CLR x1%
  1225.   FOR j%=1 TO w%
  1226.     IF UPPER$(e1$(j%))="UND" OR UPPER$(e1$(j%))="ODER" THEN
  1227.       INC x%
  1228.     ELSE IF UPPER$(e1$(1))="DU" OR UPPER$(e1$(1))="IHR"
  1229.       x1%=1
  1230.     ENDIF
  1231.   NEXT j%
  1232.   IF x1%=1 AND NOT x% THEN
  1233.     INC kz1%                    ! Zähler der kompositionstexte erhöhen
  1234.     IF kz1%>kz% THEN            ! schon alle Texte benutzt?
  1235.       kz1%=1                    ! ja, dann wieder von vorn anfangen
  1236.     ENDIF
  1237.     t$=komp$(kz1%)+" "+e1$(x1%) !
  1238.     FOR j%=x1%+2 TO w%
  1239.       t$=t$+" "+e1$(j%)
  1240.     NEXT j%
  1241.     t$=t$+" "+e1$(x1%+1)+"."
  1242.     ok%=1                       ! Flag, Textkomposition erfolgreich
  1243.   ENDIF
  1244. RETURN
  1245. PROCEDURE textstil(stil%,vfarbe%,hfarbe%)
  1246.   par$=STR$(stil%)+";"+STR$(30+vfarbe%)+";"+STR$(40+hfarbe%)
  1247.   PRINT CHR$(&H9B);par$;CHR$(&H6D);
  1248. RETURN
  1249. PROCEDURE trennzeile
  1250.   PRINT #2,STRING$(zbreite%,"-")
  1251.   CLR zzaehler%
  1252. RETURN
  1253. PROCEDURE unterbrechung
  1254.   CLR abbruch%                  ! Abbruchflag loeschen
  1255.   x$=INKEY$
  1256.   IF x$<>"" THEN
  1257.     IF x$<>CHR$(27) THEN        ! ESC gedrueckt
  1258.       x$=""                     ! nein, dann warten
  1259.       WHILE x$=""               ! warte auf Tastendruck
  1260.         x$=INKEY$
  1261.       WEND
  1262.     ELSE
  1263.       abbruch%=1                ! Abbruchflag setzen
  1264.     ENDIF
  1265.   ENDIF
  1266. RETURN
  1267. PROCEDURE vergleich
  1268.   vflag%=1                      ! OK-Flag setzen
  1269. RETURN
  1270. PROCEDURE verlegenheitsfrage    ! Verlegenheitsfrage stellen
  1271.   su$="VERLEGENHEIT"            ! Suchwort
  1272.   suchen1                       ! Wort suchen
  1273.   IF in% THEN                   ! Wort gefunden
  1274.     WHILE UPPER$(TRIM$(a$(in%-1)))=su$ ! Bereichsanfang rückwarts suchen
  1275.       DEC in%                   ! Zähler -1
  1276.     WEND
  1277.     CLR ig%                     !
  1278.     WHILE UPPER$(TRIM$(a$(in%)))=su$  ! vorwärts suchen
  1279.       INC ig%
  1280.       in%(ig%,0)=ii%            ! Wortnummer merken
  1281.       in%(ig%,1)=in%            ! Recordnummer merken
  1282.       INC in%
  1283.     WEND
  1284.   ENDIF
  1285. RETURN
  1286. PROCEDURE verzeichnis.aus       ! Listenausgabe
  1287.   oeffne.r                      ! Datenbank öffnen
  1288.   CLR zzaehler%                 ! Zeilenzähler löschen
  1289.   CLR za%
  1290.   CLR abbruch%
  1291.   sortieren                     ! Indexdatei sortieren
  1292.   tagesdatum                    ! Datum abfragen
  1293.   programmkopf
  1294.   von%=1
  1295.   bis%=tx%
  1296.   IF gadr%=1 THEN               ! Liste in Datei schreiben
  1297.     x2%=3
  1298.     anweisung(22)
  1299.     programmname                ! Programmnamen abfragen/Abbruch
  1300.     IF abbruch%=1 THEN          ! Abbruch gewählt?
  1301.       GOTO verzeichnis.aus.ende ! ja, dann PROCEDURE abbrechen
  1302.     ENDIF
  1303.     programmkopf
  1304.     OPEN "o",#2,pfad$(x2%)+dateiname$ ! Datei öffnen
  1305.     zbreite%=dz%*(dl%)+dz%      ! Anzahl der Zeichen je Druckzeile
  1306.     mz%=dz%                     ! ein- oder zweispaltiger Druck
  1307.     PRINT AT(3,28);"Datenausgabe in Datei. Schreibe Datensatz Nummer:"
  1308.     PRINT AT(63,28);"bis: ";bis%
  1309.     anweisung(16)
  1310.   ELSE IF gadr%=4               ! Liste auf Drucker
  1311.     aw%=8
  1312.     abfrage.nein
  1313.     IF y$="J" THEN              ! Drucker ist richtig eingestellt
  1314.       zbreite%=dz%*(dl%)+dz%    ! Anzahl der Zeichen je Druckzeile
  1315.       OPEN "o",#2,"PRT:"        ! Drucker ist Ausgabegerät
  1316.       PRINT AT(4,28);"Datenausgabe auf Drucker. Schreibe Datensatz Nr:"
  1317.       PRINT AT(63,28);"bis: ";bis%
  1318.       anweisung(16)
  1319.     ELSE                        ! Drucker ist noch nicht eingestellt
  1320.       abbruch%=1                ! Abbruchflag setzen
  1321.     ENDIF
  1322.   ENDIF
  1323.   i%=von%-1
  1324.   WHILE i%<bis% AND abbruch%=0
  1325.     INC i%
  1326.     unterbrechung
  1327.     satz.lesen                  ! Datensatz lesen
  1328.     IF zzaehler%>=druckzeilen% THEN
  1329.       trennzeile
  1330.       fusszeile
  1331.     ENDIF
  1332.     IF zzaehler%=0 AND za%=0
  1333.       sternzeile
  1334.       kopfzeile
  1335.       druckfeldname
  1336.       PRINT #2
  1337.       trennzeile
  1338.     ENDIF
  1339.     IF gadr%<>3 THEN          ! Ausgabe in Datei?
  1340.       PRINT AT(53,28);i%      ! ja, dann anzeigen daß ich arbeite
  1341.     ENDIF
  1342.     FOR j%=1 TO be%
  1343.       IF pt%(j%)>0 THEN       ! Datenfeld ausgeben, 0 = nicht ausgeben
  1344.         PRINT #2,te$(pt%(j%));SPC(1);  ! Datenfeld ausgeben
  1345.       ENDIF
  1346.     NEXT j%
  1347.     IF mz%>1 THEN             ! zwei Datensätze je Zeile?
  1348.       INC za%                 ! ja, Zähler erhöhen
  1349.       IF za%<mz% THEN         ! schon 2 Datensätze ausgegeben?
  1350.         GOTO verz3            ! ja, dann weiter
  1351.       ENDIF
  1352.       IF sl%=zbreite% THEN
  1353.         GOTO verz2
  1354.       ENDIF
  1355.     ENDIF
  1356.     PRINT #2
  1357.     verz2:
  1358.     INC zzaehler%             ! Zeilenzähler +1
  1359.     CLR za%                   ! Doppelspaltenzähler zurücksetzen
  1360.     verz3:
  1361.   WEND
  1362.   IF gadr%<>3 AND abbruch%=0 THEN       ! Zeilenvorschub letzte Seite
  1363.     FOR zzaehler%=zzaehler%+1 TO druckzeilen%
  1364.       PRINT #2,
  1365.     NEXT zzaehler%
  1366.     trennzeile
  1367.     fusszeile
  1368.   ENDIF
  1369.   verzeichnis.aus.ende:
  1370.   CLOSE
  1371.   CLR x2%
  1372. RETURN
  1373. PROCEDURE zeile.zerlegen        ! Eingabe des Gesprächpartners zerlegen
  1374.   x$=RIGHT$(e$,1)               ! Satzzeichen merken
  1375.   CLR frage%                    ! Frageflag löschen
  1376.   IF x$="?" THEN                ! Frage?
  1377.     frage%=1                    ! ja, dann Flag für Fragezeile setzen
  1378.     e$=LEFT$(e$,LEN(e$)-1)      ! Satzzeichen entfernen
  1379.   ELSE IF x$="!" OR x$="."
  1380.     e$=LEFT$(e$,LEN(e$)-1)      ! Satzzeichen entfernen
  1381.   ENDIF
  1382.   e%=LEN(e$)                    ! Länge der Eingabe für Auswertungen
  1383.   PRINT AT(3,28);SPACE$(76)
  1384.   IF e%>3 THEN                  ! ab 3 Zeichen Auswerten
  1385.     PRINT AT(30,28);"Laß mich überlegen."
  1386.     CLR w%
  1387.     CLR j%
  1388.     WHILE j%<e%                 ! Position < der Eingabezeile?
  1389.       INC w%                    ! Wortzähler plus 1
  1390.       e$(w%)=""                 ! Wort löschen
  1391.       x$=""                     ! Zeichen löschen
  1392.       WHILE j%<e% AND x$<>" "
  1393.         INC j%                  ! Position in der Eingabe plus 1
  1394.         x$=MID$(e$,j%,1)        ! ein Zeichen merken
  1395.         IF x$<>" " THEN         ! <> Space
  1396.           e$(w%)=e$(w%)+x$      ! ja, dann Zeichen übernehmen
  1397.         ENDIF
  1398.       WEND
  1399.     WEND
  1400.   ENDIF
  1401.   erste.person.ersetzen         ! 1. Person durch 2. Person ersetzen
  1402. RETURN
  1403. PROCEDURE zeichne.regler
  1404.   zeile=5                       !  Position der Eingabezeile
  1405.   FOR i4%=0 TO 7
  1406.     LOCATE 1,2*i4%+zeile+2
  1407.     PRINT "    ";feld1$(i4%);   !  Bezeichnung des Schiebereglers
  1408.     WHILE CRSCOL<50
  1409.       PRINT ".";                !  Punktreihe bis zum Schieberegler
  1410.     WEND
  1411.     x2(i4%)=(CRSCOL*8)+10      !  Grafik-Cursorpositionen uebergeben
  1412.     y1(i4%)=(CRSLIN*8)-8
  1413.     x3(i4%)=(CRSCOL*8)+200
  1414.     y2(i4%)=(CRSLIN*8)
  1415.     GOSUB zeichne.boxen         !  Kontrollboxen zeichnen
  1416.   NEXT i4%
  1417. RETURN
  1418. PROCEDURE zeichne.boxen         !  Kontrollbox zeichnen
  1419.   COLOR 1
  1420.   PBOX x2(i4%)-2,y1(i4%)-1,x3(i4%)+2,y2(i4%)+1
  1421.   COLOR 3                       !  Kontrollbox zeichnen
  1422.   PBOX x2(i4%),y1(i4%),x3(i4%),y2(i4%)
  1423.   x=(akt1%(i4%)-mi(i4%))/(ma(i4%)-mi(i4%))
  1424.   x=x2(i4%)+x*(x3(i4%)-x2(i4%))
  1425.   COLOR 2                       !  Schieberegler zeichnen
  1426.   PBOX x+1,y1(i4%),x,y2(i4%)
  1427. RETURN
  1428. PROCEDURE init                  ! Programm initialisieren
  1429.   ON ERROR GOSUB fehler
  1430.   MODE 0
  1431.   dial%=-1                      ! Dialogausgabe einschalten
  1432.   sprache%=-1                   ! Sprachausgabe eingeschaltet
  1433.   bl%=146                       ! Voreinstellung für Druckbreite
  1434.   zl%=80                        ! Anzahl der Spalten für Bildschirmausgabe
  1435.   CLR x2%
  1436.   un%=10                        ! Anzahl der Datenpflegemenüs
  1437.   sel%=5                        ! Anzahl der Selektierfunktionen
  1438.   at%=35                        ! Anzahl der Anweisungen
  1439.   sz%=4                         ! Startzeile der Bildschirmausgabe
  1440.   ez%=21                        ! Zeilenanzahl der Bildschirmmaske
  1441.   fz%=21                        ! Anz. Datenfelder
  1442.   breite%=640                   ! Screenbreite
  1443.   hoehe%=256                    ! Screenhöhe
  1444.   ebenen%=3                     ! 2 Bitplanes
  1445.   OPENS 1,0,0,breite%,hoehe%,ebenen%,&H8000
  1446.   OPENW #1,0,0,breite%,hoehe%,&H18,&H1800,1
  1447.   farben.setzen                 ! Farbpalette setzen
  1448.   init.variable                 ! Variable initialisieren
  1449.   lese.umenue(un%)
  1450.   FOR j%=0 TO at%
  1451.     READ ax%(j%),ay%(j%),aw$(j%),dummy%
  1452.   NEXT j%
  1453.   CLR kz%
  1454.   RESTORE komptexte
  1455.   WHILE komp$(kz%)<>"ende"
  1456.     INC kz%
  1457.     READ komp$(kz%)
  1458.   WEND
  1459.   DEC kz%
  1460. RETURN
  1461. PROCEDURE init.variable
  1462.   DIM feld1$(8),mi(8),ma(8),akt1%(8)! für die Sprachausgabe
  1463.   DIM x2(8),x3(8),y1(8),y2(8)
  1464.   DIM in%(200,1)                ! Recordnummer für gefundene Schlüsselworte
  1465.   DIM m$(ez%)                   ! Bildschirmmaske
  1466.   DIM td1$(ez%),id%(ez%)        !
  1467.   DIM mx%(ez%),my%(ez%)         ! Zeilen und Spalten der Datenfelder (Maske)
  1468.   DIM ax%(at%),ay%(at%),aw$(at%)! Anweisungstexte und Position
  1469.   DIM pfad$(3),d$(3)            ! Pfadnamen und Dateinamen
  1470.   DIM maske$(3)
  1471.   DIM text$(2)                  ! Listenbeschriftung
  1472.   DIM tv$(fz%)                  ! Vergleichsmasken
  1473.   DIM pt%(fz%),po%(fz%),feldp%(fz%)! Reihenfolge und Position der Datenfelder
  1474.   DIM su$(fz%),su%(fz%)         ! Suchstring und Flag
  1475.   DIM te$(fz%),td$(fz%),td%(fz%)! Feldinhalt, Datenfeldname und Datenfeldlänge
  1476.   DIM dr$(fz%)                  ! Datenfeldnamen
  1477.   DIM x1%(fz%),x4%(fz%),vg%(fz%),sa%(fz%),ersatz$(fz%) ! Selektieren
  1478.   DIM menue$(16)                ! Anzahl der Menüs
  1479.   DIM ux%(un%),uy%(un%),ux$(un%)! Eingabe-Menüs
  1480.   DIM e$(30),e1$(30)            ! Anzahl der Worte eines Satzes
  1481.   DIM komp$(30)                 ! Anzahl der Kompositonstexte
  1482. RETURN
  1483. PROCEDURE menueein              ! Menüs einschalten
  1484.   menue$(0)=" Eliza "
  1485.   menue$(1)=" Info                    "
  1486.   menue$(2)=" Dialog mit Eliza "
  1487.   menue$(3)=" Dialogdatei pflegen "
  1488.   menue$(4)="+Q Programm beenden "
  1489.   menue$(5)=""
  1490.   menue$(6)=" Voreinstellungen "
  1491.   menue$(7)="   Sprache an/aus "
  1492.   menue$(8)="   Spracheinstellung "
  1493.   menue$(9)="   Lernmodus an/aus "
  1494.   menue$(10)="   Dialogaufzeichnung "
  1495.   menue$(11)=""
  1496.   menue$(12)=" Datenausgabe "
  1497.   menue$(13)="  Wortschatz auf Drucker "
  1498.   menue$(14)="  Wortschatz in Datei "
  1499.   menue$(15)=""
  1500.   menue$(16)=""
  1501.   MENU menue$()
  1502.   MENU 7,&H153                  ! Menüpunkt abhaken
  1503.   MENU 9,&HC0                   ! Menüpunkt abhaken
  1504.   MENU 10,&H153                 ! Menüpunkt abhaken
  1505. RETURN
  1506. PROCEDURE daten                 ! Daten für Menüs und Anweisungen
  1507.   um1:
  1508.   DATA  4,28,"       "
  1509.   DATA 12,28,"suchen"
  1510.   DATA 19,28,"ändern"
  1511.   DATA 26,28,"löschen"
  1512.   DATA 34,28,"1.Satz"
  1513.   DATA 41,28,"zurück"
  1514.   DATA 48,28,"vorwärts"
  1515.   DATA 57,28,"tab Ende"
  1516.   DATA 66,28,"       "
  1517.   DATA 74,28,"Ende"
  1518.   '
  1519.   DATA 31, 5,"Variable Anweisung",0
  1520.   DATA 28,12,"Soll eine bestehende Maske verwendet werden",1
  1521.   DATA 28,30,"Sind Sie sicher",2
  1522.   DATA 28,22,"Sind alle Angaben richtig",3
  1523.   DATA 31, 6,"Suchbegriffe eingeben und mit RETURN bestätigen. Weiter mit RETURN.",4
  1524.   DATA 31,24,"Steuerung mit den Cursor-Tasten",5
  1525.   DATA 31, 6,"Beenden der Einstellung durch Mausklick in die linke Bildschirmhälfte.",6
  1526.   DATA 31,10,"Dialog mit Eliza kann durch die Eingabe von 'quit' beendet werden.",7
  1527.   DATA 28, 4,"Ist die Druckbreite von mehr als 89 Zeichen eingestellt",8
  1528.   DATA 31,10,"",9
  1529.   DATA 31, 4,"",10
  1530.   DATA 31,14,"",11
  1531.   DATA 31,18,"",12
  1532.   DATA 28,20,"",13
  1533.   DATA 31, 4,"Dateneingabe oder Datenänderung können Sie nur mit der 'Esc'-Taste beenden.",14
  1534.   DATA 31, 4,"",15
  1535.   DATA 31, 8,"Unterbrechung mit beliebiger Taste, Abbruch mit der « Esc-Taste » ",16
  1536.   DATA 31, 4,"",17
  1537.   DATA 31, 4,"Anwahl = linke Maustaste, Cursor, Buchst. Start = rechte Maustaste, RETURN",18
  1538.   DATA 28,10,"",19
  1539.   DATA 31, 4,"Bitte zutreffendes anwählen:",20
  1540.   DATA 28, 4,"Bitte Namen der Wortschatz-Datei auswählen. Endung '.Daten'.",21
  1541.   DATA 28, 4,"",22
  1542.   DATA 28,13,"",23
  1543.   DATA 31,30,"Sortierung läuft!",24
  1544.   DATA 28,10,"",25
  1545.   DATA 28, 4,"",26
  1546.   DATA 31, 5,"Bitte wählen Sie einen Menüpunkt. Eliza V1.20 (c) 10.9.1991 by KG-Soft",27
  1547.   DATA 31,10,"Der interne Speicher ist voll. Weiter mit beliebiger Taste",28
  1548.   DATA 28, 4,"",29
  1549.   DATA 31, 4,"",30
  1550.   DATA 28,14,"",31
  1551.   DATA 22,20,"Übernommenen Datensatz ergänzen",32
  1552.   DATA 31, 4,"Ordner sind mit '*' gekennzeichet. Zum Ordnerwechsel nur einmal klicken.",33
  1553.   DATA 28, 4,"Auswertung in neue Datei (J), an vorhandene Datei anhängen (N)",34
  1554.   DATA 28, 4,"",35
  1555.   um2:
  1556.   DATA 50,28," = "
  1557.   DATA 55,28," <> "
  1558.   DATA 60,28," < "
  1559.   DATA 65,28," > "
  1560.   DATA 70,28," * "
  1561.   voreinstellung:
  1562.   '                Minimalwert, Maximalwert, Voreinstellung
  1563.   DATA "Ton-Höhe",65,320,110
  1564.   DATA "Silbenbetonung an/aus",0,1,0
  1565.   DATA "Sprechgeschwindigkeit",40,400,150
  1566.   DATA "männlich/weiblich",0,1,0
  1567.   DATA "Stimmlage tief/hoch",5000,28000,22200
  1568.   DATA "Lautstärkeregler",0,63,63
  1569.   DATA "Balance-Regler links/rechts",0,10,5
  1570.   DATA "Synchrone Sprachausgabe an/aus",0,1,0
  1571.   phoneme:
  1572.   DATA A,8,AEU,OY,AEH,AEAE,AY,AY,AI,AY,AH,AAAA,AU,AW,AE,AE,A,AA
  1573.   DATA B,1,B,B
  1574.   DATA C,8,CAE,TSAE," CH"," K",CHS,KS,CH,/C,CK,K,CE,TSEH,CI,TSIH,C,K
  1575.   DATA D,1,D,D
  1576.   DATA E,9,"EN ","IN ","EL ","IL ","ES ","IXS ",EI,AY,EY,AY,EH,EH,EU,OY,EN,EHN,E,EH
  1577.   DATA F,1,F,F
  1578.   DATA G,1,G,G
  1579.   DATA H,1,H,/H
  1580.   DATA I,3,IE,IY,IH,IY,I,IX
  1581.   DATA J,2," J"," IHY",J,Y
  1582.   DATA K,1,K,K
  1583.   DATA L,1,L,L
  1584.   DATA M,1,M,M
  1585.   DATA N,1,N,N
  1586.   DATA O,7,OEH,ER,OE,ER,OU,UH,OI,OY,OH,OH,O,OH,OY,OY
  1587.   DATA P,2,PH,F,P,P
  1588.   DATA Q,1,Q,KV
  1589.   DATA R,3," R","R","R ","RX","R","R"
  1590.   DATA S,22,SCH,SH,"ST ","ST ",SB,SB,SD,SD,SF,SF,SG,SG,SH,S/H,SR,SR,SS,S
  1591.   DATA SJ,SY,SK,SK,SL,SL,SM,SM,SN,SN,SP,SHP,SQ,SKV,SZ,STS,S,Z,SV,SF
  1592.   DATA ST,SHT,SW,SV,SX,SKS
  1593.   DATA T,6," TIO",TSIYAA,TIA,TSIYAA,TZ,TS,TH,TT,TT,TT,T,DT
  1594.   DATA U,5, UEH,ER, UE,ER, UH,UW,"U ","UW ",U,UH
  1595.   DATA V,1,V,F
  1596.   DATA W,1,W,V
  1597.   DATA X,1,X,KS
  1598.   DATA Y,2," YH","IH","Y","IH"
  1599.   DATA Z,2," Z",TS,"Z","TS"
  1600.   REM Ersatz fuer Space
  1601.   DATA "@",1,"@"," "
  1602.   REM Ersatz fuer _
  1603.   DATA "_",1,"_",QX
  1604.   REM Ersatz fuer ä
  1605.   DATA "[",3,"[U",OY,"[H",EH,"[",AE
  1606.   REM Ersatz fuer ö
  1607.   DATA "\",2,"\H",ER,"\",ER
  1608.   REM Ersatz fuer
  1609.   DATA "]",2,"]H",ER,"]",ER
  1610.   DATA "^",1,"^",S
  1611.   DATA ende,0
  1612. RETURN
  1613. PROCEDURE daten1
  1614.   beugungen:
  1615.   DATA "bin","bist"
  1616.   ' DATA "dachte","dachtest"
  1617.   DATA "denke","denkst"
  1618.   DATA "fahre","fährst"
  1619.   '  DATA "finde","findest"
  1620.   DATA "finden","findest"
  1621.   DATA "geht",ging""
  1622.   DATA "ging","gingst"
  1623.   DATA "habe","hast"
  1624.   DATA "haben","habt"
  1625.   DATA "halte","hältst"
  1626.   ' DATA "hatte","hattest"
  1627.   DATA "heißt","heiße"
  1628.   DATA "heisst","heiße"
  1629.   DATA "intressiere","intressierst"
  1630.   '  DATA "kann","kannst"
  1631.   DATA "liebe","liebst"
  1632.   DATA "mache","machst"
  1633.   '  DATA "mag","magst"
  1634.   DATA "meiner","Deiner"
  1635.   ' DATA "möchte","möchtest"
  1636.   DATA "soll","sollte"
  1637.   DATA "war","warst"
  1638.   DATA "waren","ward"
  1639.   DATA "weiß","weist"
  1640.   DATA "werde","wirst"
  1641.   DATA "wollen","wollt"
  1642.   '  DATA "wollte","wolltest"
  1643.   '  DATA "würde","würdest"
  1644.   DATA "ende","ende"
  1645.   komptexte:
  1646.   DATA "Es ist doch schön, daß"
  1647.   DATA "Das finde ich richtig, daß"
  1648.   DATA "Das interessiert mich nicht, daß"
  1649.   DATA "Es ist nicht wichtig, daß"
  1650.   DATA "Wen interessiert das schon, daß"
  1651.   DATA "Ist das so wichtig, daß"
  1652.   DATA "Erzähle das Deinem Frisör, daß"
  1653.   DATA "ende","ende"
  1654. RETURN
  1655. PROCEDURE farben.setzen
  1656.   SETCOLOR 0,5,5,5              ! grau statt blau
  1657.   SETCOLOR 1,15,15,15           ! weiß bleibt
  1658.   SETCOLOR 2,0,0,0              ! schwarz erhalten
  1659.   SETCOLOR 3,15,5,0             ! rot bleibt
  1660.   SETCOLOR 4,10,10,10           ! hellgrau
  1661.   SETCOLOR 5,0,0,15             ! blau
  1662.   SETCOLOR 6,15,15,0            ! gelb
  1663.   SETCOLOR 7,0,0,0              ! schwarz erhalten
  1664. RETURN
  1665. PROCEDURE info
  1666.   programmkopf
  1667.   PCOLOR 6,0
  1668.   PRINT AT(1,5);"Eliza V1.20";
  1669.   PCOLOR 1,0
  1670.   PRINT " ist ein Programm, daß eine künstliche Intelligenz simuliert."
  1671.   PRINT AT(1,7);"Die deutsche Sprachausgabe ist noch nicht perfekt, dafür aber abschaltbar."
  1672.   PRINT AT(1,9);"Der Lernmodus ist in der PD-Version nicht vorhanden."
  1673.   PRINT AT(1,11);""
  1674.   PCOLOR 3,0
  1675.   PRINT AT(10,23);"(c) 1991 by Henry König, Bornheide 71, 2000 Hamburg 53"
  1676.   PCOLOR 1,0
  1677.   PRINT AT(5,25);"Dieses Programm darf kopiert und in jede PD-Serie übernommen werden."
  1678.   tastendruck
  1679. RETURN
  1680. PROCEDURE init.deutsch          !  deutschen Text wandeln
  1681.   abz%=64                       !  ASCII-Wert des 1. gueltigen Zeichens
  1682.   n1%=0
  1683.   n2%=0
  1684.   RESTORE phoneme
  1685.   x$=""                         !  Eingangswert für die Schleife
  1686.   WHILE x$<>"ende"
  1687.     READ x$,n4%                 !  Anzahl der Ersatz-Phoneme je Zeile
  1688.     IF n4%>0 THEN
  1689.       a4%=ASC(x$)               !  ASCII-Wert
  1690.       IF a4%>n1% THEN           !  gelesener Wert > letztem Wert?
  1691.         n1%=a4%                 !  ja, dann fuer DIM merken
  1692.       ENDIF
  1693.       IF n4%>n2% THEN
  1694.         n2%=n4%
  1695.       ENDIF
  1696.       FOR i4%=1 TO n4%          !  Anzahl der Phoneme je Zeile
  1697.         READ x$,x$              !  ueberlesen
  1698.       NEXT i4%
  1699.     ENDIF
  1700.   WEND
  1701.   n1%=n1%-abz%
  1702.   DIM te1$(n1%,n2%),ph$(n1%,n2%),n5%(n1%) !     Array fuer Phoneme
  1703.   RESTORE phoneme
  1704.   x$=""
  1705.   WHILE x$<>"ende"
  1706.     READ x$,n4%
  1707.     IF n4%>0 THEN
  1708.       x%=ASC(x$)
  1709.       n5%(x%-abz%)=n4%
  1710.       FOR i4%=1 TO n4%          ! Anzahl der Phoneme
  1711.         READ te1$(x%-abz%,i4%)  ! Buchstabe oder Buchstabenfolge lesen
  1712.         READ ph$(x%-abz%,i4%)   ! Phoneme für Buchstabe oder Buchstabenfolge
  1713.       NEXT i4%
  1714.     ENDIF
  1715.   WEND
  1716. RETURN
  1717. PROCEDURE init.sprache
  1718.   RESTORE voreinstellung
  1719.   FOR i4%=0 TO 7
  1720.     READ feld1$(i4%),mi(i4%),ma(i4%),akt1%(i4%)
  1721.   NEXT i4%
  1722. RETURN
  1723. REM
  1724.